home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / src-server / wc_SHELL.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-04  |  34.8 KB  |  853 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         wc_SHELL.c
  5. * RCS:          $Header: wc_SHELL.c,v 1.6 91/04/08 14:06:52 mayer Exp $
  6. * Description:  SHELL_WIDGET/POPUP_SHELL_WIDGET metaclass + class instances.
  7. * Author:       Niels Mayer, HPLabs
  8. * Created:      Fri Oct 27 22:03:22 1989
  9. * Modified:     Thu Oct  3 23:40:48 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. *
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: wc_SHELL.c,v 1.6 91/04/08 14:06:52 mayer Exp $";
  43.  
  44. #include <stdio.h>
  45. #include <X11/Intrinsic.h>
  46. #include <X11/Shell.h>
  47. #include <Xm/Xm.h>
  48. #include <Xm/DialogS.h>
  49. #include <Xm/MenuShell.h>
  50.  
  51. #include "winterp.h"
  52.  
  53. /* this must come after winterp.h since WINTERP_MOTIF_11 may be def'd there */
  54. #ifdef WINTERP_MOTIF_11
  55. #include <Xm/Protocols.h>    /* <Xm/Protocols.h> location seems to have moved in 1.1 */
  56. #else
  57. #include <X11/Protocols.h>
  58. #endif                /* WINTERP_MOTIF_11 */
  59.  
  60. #include "user_prefs.h"
  61. #include "xlisp/xlisp.h"
  62. #include "w_funtab.h"
  63.  
  64.  
  65. extern Widget Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(); /* w_classes.c */
  66.  
  67.  
  68. typedef struct _ShellWidgetAssoc_Node {
  69.   LVAL                 widget_OBJ;
  70.   Widget             widget_ID;
  71.   struct _ShellWidgetAssoc_Node* next;
  72. } ShellWidgetAssoc_Node;
  73.  
  74. static ShellWidgetAssoc_Node* shell_widget_alist = NULL;
  75.  
  76.  
  77. /*****************************************************************************
  78.  * This removes the (widget_OBJ . widget_ID) association from shell_widget_alist
  79.  * when the shell widget gets destroyed. It is called from
  80.  * Wshl_Assoc_WidgetID_With_WIDGETOBJ() via XtAddCallback().
  81.  ****************************************************************************/
  82. static void Wshl_Widget_Destroy_CallbackProc(widgetID, client_data, call_data)
  83.      Widget    widgetID;
  84.      XtPointer client_data;    /* type is really the ShellWidgetAssoc_Node* to be destroyed */
  85.      XtPointer call_data;
  86. {
  87.   register ShellWidgetAssoc_Node* cur;
  88.   register ShellWidgetAssoc_Node* prev;
  89.   register ShellWidgetAssoc_Node* elt_to_destroy = (ShellWidgetAssoc_Node*) client_data;
  90.  
  91.   if (!shell_widget_alist)    /* ASSERT(shell_widget_alist!=NULL): something has gone awry if this callbackproc got called but shell_widget_alist is empty. */
  92.     xlfatal("Internal error 0 in Wshl_Widget_Destroy_CallbackProc().");
  93.  
  94.   prev = (ShellWidgetAssoc_Node*) NULL;
  95.   cur = shell_widget_alist;
  96.   while (cur && (cur != elt_to_destroy)) {
  97.     prev = cur;
  98.     cur = cur->next;
  99.   }
  100.   if (!prev) {            /* shell_widget_alist == cur == elt_to_destroy */
  101.     shell_widget_alist = shell_widget_alist->next; /* pop the first elt */
  102.     XtFree(cur);
  103.   }
  104.   else if (cur) {        /* cur == elt_to_destroy */
  105.     prev->next = cur->next;    /* remove cur from alist */
  106.     XtFree(cur);
  107.   }
  108.   else            /* ASSERT(cur!=NULL): something has gone awry if this callbackproc got called but can't find elt_to_destroy in shell_widget_alist. */
  109.     xlfatal("Internal error 1 in Wshl_Widget_Destroy_CallbackProc().");
  110. }
  111.  
  112.  
  113. /*****************************************************************************
  114.  * This associates a WIDGETOBJ with a WIDGETID and stores it on the assoc list
  115.  * shell_widget_alist. This routine is needed to set up data for
  116.  * Wshl_WidgetID_To_WIDGETOBJ().
  117.  ****************************************************************************/
  118. static void Wshl_Assoc_WidgetID_With_WIDGETOBJ(widget_id, o_widget)
  119.      Widget widget_id;
  120.      LVAL o_widget;
  121. {
  122.   ShellWidgetAssoc_Node* elt = (ShellWidgetAssoc_Node*) XtMalloc(sizeof(ShellWidgetAssoc_Node));
  123.   elt->widget_OBJ = o_widget;
  124.   elt->widget_ID  = widget_id;
  125.  
  126.   if (shell_widget_alist)
  127.     elt->next = shell_widget_alist;
  128.   else
  129.     elt->next = NULL;        /* elt is the only one on the alist */
  130.  
  131.   shell_widget_alist = elt;    /* make elt the new head of the list */
  132.  
  133.   XtAddCallback(widget_id, XmNdestroyCallback, Wshl_Widget_Destroy_CallbackProc, (XtPointer) elt); /* this removes elt when widget is destoyed */
  134. }
  135.  
  136.  
  137. /*****************************************************************************
  138.  * On all widgets other than shell widgets, we can retrieve the WIDGETOBJ
  139.  * associated with a particular Xt widget_id by retrieving the XmNuserData
  140.  * resource. Unfortunately, shell widgets do not have that resource, so we
  141.  * have to set up a special lookup mechanism. 
  142.  *
  143.  * Note: this routine uses a linear search through the association list 
  144.  * pointed at by shell_widget_alist. Since I don't expect applications to 
  145.  * have zillions of shell widgets, I think a linear search will be adequate.
  146.  ****************************************************************************/
  147. LVAL Wshl_WidgetID_To_WIDGETOBJ(widget_id)
  148.      Widget widget_id;
  149. {
  150.   extern void Wcls_Initialize_WIDGETOBJ(); /* w_classes.c */
  151.   extern LVAL Wcls_WidgetClassID_To_WIDGETCLASSOBJ(); /* w_classes.c */
  152.   extern LVAL o_WIDGET_CLASS;    /* from wc_WIDGET.c */
  153.   register ShellWidgetAssoc_Node* cur;
  154.   LVAL o_widgetclass, o_widget;
  155.  
  156.   /*
  157.    * first, try to find widgetobj corresponding to widget_id by doing a linear
  158.    * search on list created by Wshl_Assoc_WidgetID_With_WIDGETOBJ() returning
  159.    * that WIDGETOBJ if successful
  160.    */
  161.   cur = shell_widget_alist;
  162.   while (cur && (cur->widget_ID != widget_id))
  163.     cur = cur->next;
  164.   if (cur)            /* cur->widget_ID == widget_id */
  165.     return (cur->widget_OBJ);
  166.  
  167.   /*
  168.    * we couldn't find WIDGETOBJ associated with widget_id, so create a WIDGETOBJ
  169.    * of the appropriate class.
  170.    */
  171.   if (o_widgetclass = Wcls_WidgetClassID_To_WIDGETCLASSOBJ(XtClass(widget_id)))    /* returns NIL on failure */
  172.     o_widget = newobject(o_widgetclass, WIDGETOBJ_SIZE);
  173.   else {            /* fail gracefully (i think). */
  174.     errputstr("Warning -- In Wshl_WidgetID_To_WIDGETOBJ() couldn't find a valid\n");
  175.     errputstr("           widgetclass object inside widget classrecord. Creating\n");
  176.     errputstr("           a \"generic\" WIDGETOBJ of class WIDGET_CLASS.\n");
  177.     o_widget = newobject(o_WIDGET_CLASS, WIDGETOBJ_SIZE);
  178.   }
  179.   
  180.   Wcls_Initialize_WIDGETOBJ(o_widget, widget_id);
  181.   Wshl_Assoc_WidgetID_With_WIDGETOBJ(widget_id, o_widget);
  182.   return (o_widget);  
  183. }
  184.  
  185.  
  186.  
  187. /*****************************************************************************
  188.  * (send <Shell_Widget_Class> :new
  189.  *                                 [<name>]
  190.  *                   [<class-name>]
  191.  *                                 [:XMN_<arg1> <val1>]
  192.  *                                 [. . .             ]
  193.  *                                 [:XMN_<argN> <valN>])
  194.  *
  195.  * For the <Shell_Widget_Class> metaclass,
  196.  * create a new widget via XtAppCreateShell().
  197.  ****************************************************************************/
  198. LVAL Shell_Widget_Class_Method_ISNEW()
  199. {
  200.   extern ArgList Wres_Get_LispArglist(); /* from w_resources.c */
  201.   extern void    Wres_Free_C_Arglist_Data(); /* from w_resources.c */
  202.   extern WidgetClass Wcls_WIDGETCLASSOBJ_To_WidgetClassID(); /* w_classes.c */
  203.   extern Widget   toplevel_Wgt;    /* from winterp.c -- see "NOTE POTENTIAL BUG" comment below */
  204.   extern Display* display;    /* from winterp.c -- see "NOTE POTENTIAL BUG" comment below */
  205.   extern char*    app_class;    /* from winterp.c -- the class name of the application (defaults to "Winterp" unless given command-line -class <classname>) */
  206.   LVAL self;
  207.   char* name;
  208.   char* class_name;
  209.   WidgetClass widgetclass_id;
  210.   Widget widget_id;
  211.  
  212.   self = xlgaobject();        /* NOTE: xlobj.c:clnew() returns an OBJECT; if this method
  213.                    returns successfully, it will return a WIDGETOBJ */
  214.  
  215.   /* get optional <name> arg */
  216.   if (moreargs() && (stringp(*xlargv)))
  217.     name = (char*) getstring(nextarg());
  218.   else
  219.     name = "";            /* default name */
  220.  
  221.   /* get optional <class_name> arg */
  222.   if (moreargs() && (stringp(*xlargv)))
  223.     class_name = (char*) getstring(nextarg());
  224.   else
  225.     class_name = app_class;    /* default name */
  226.  
  227.   if (!(widgetclass_id = Wcls_WIDGETCLASSOBJ_To_WidgetClassID(getclass(self))))
  228.     xlerror("Expected a 'Class' object that is a subclass of 'WIDGET_CLASS'.", self);
  229.  
  230.   if (moreargs()) {        /* if there are more arguments, */
  231.     Cardinal xt_numargs;    /* then we have some extra widget resources to set */
  232.     ArgList xt_arglist = Wres_Get_LispArglist(self, toplevel_Wgt, NULL, 0, &xt_numargs);
  233.  
  234.     /* NOTE POTENTIAL BUG: above, we pass toplevel_Wgt as the widget for
  235.        Wres_Get_LispArglist(). toplevel_Wgt is created by XtInitialize() in
  236.        winterp.c:main(). Wres_Get_LispArglist() may need to use that widget
  237.        for particular kinds of argument conversions done through XtConvert().
  238.        These resource converters reference things like the display/screen/
  239.        foreground/background. For those cases, do not attempt to invoke
  240.        XtConvert() by passing string-valued arguments to this method. Instead,
  241.        create the shell widget, and then use :set_values to set the arguments
  242.        requiring such conversions. This will really break bigtime if I ever
  243.        implement multiple AppContexts for multiscreen usage of WINTERP.
  244.        
  245.        Note also that below, we pass the global "display" -- this will have
  246.        to change for multi-display use....*/
  247.  
  248.     widget_id = XtAppCreateShell(name, class_name, widgetclass_id, display, xt_arglist, xt_numargs);
  249.     Wres_Free_C_Arglist_Data();
  250.   }
  251.   else
  252.     widget_id = XtAppCreateShell(name, class_name, widgetclass_id, display, NULL, 0);
  253.  
  254.   Wcls_Initialize_WIDGETOBJ(self, widget_id);
  255.   Wshl_Assoc_WidgetID_With_WIDGETOBJ(widget_id, self);
  256.   
  257. #ifdef DEBUG_WINTERP_1
  258.   Wcls_Print_WidgetObj_Info(self);
  259. #endif
  260.   return (self);
  261. }
  262.  
  263. /*****************************************************************************
  264.  * (send APPLICATION_SHELL_WIDGET_CLASS :new
  265.  *                                 [<name>]
  266.  *                   [<class-name>]
  267.  *                                 [:XMN_<arg1> <val1>]
  268.  *                                 [. . .             ]
  269.  *                                 [:XMN_<argN> <valN>])
  270.  *
  271.  * For the APPLICATION_SHELL_WIDGET_CLASScreate a new widget via
  272.  * XtAppCreateShell().
  273.  *
  274.  * This is the same as the normal shell creation routine except that this
  275.  * overrides the application shell's delete response so that WINTERP is
  276.  * exited cleanly via wrapup().
  277.   ****************************************************************************/
  278. LVAL Application_Shell_Widget_Class_Method_ISNEW()
  279. {
  280.   extern ArgList Wres_Get_LispArglist(); /* from w_resources.c */
  281.   extern void    Wres_Free_C_Arglist_Data(); /* from w_resources.c */
  282.   extern WidgetClass Wcls_WIDGETCLASSOBJ_To_WidgetClassID(); /* w_classes.c */
  283.   extern Widget   toplevel_Wgt;    /* from winterp.c -- see "NOTE POTENTIAL BUG" comment below */
  284.   extern Display* display;    /* from winterp.c -- see "NOTE POTENTIAL BUG" comment below */
  285.   extern char*    app_class;    /* from winterp.c -- the class name of the application (defaults to "Winterp" unless given command-line -class <classname>) */
  286.   extern Atom     wm_delete_atom; /* from winterp.c */
  287.   extern void     Winterp_Application_Shell_WMDelete_Callback(); /* from winterp.c */
  288.   LVAL self;
  289.   char* name;
  290.   char* class_name;
  291.   WidgetClass widgetclass_id;
  292.   Widget widget_id;
  293.  
  294.   self = xlgaobject();        /* NOTE: xlobj.c:clnew() returns an OBJECT; if this method
  295.                    returns successfully, it will return a WIDGETOBJ */
  296.  
  297.   /* get optional <name> arg */
  298.   if (moreargs() && (stringp(*xlargv)))
  299.     name = (char*) getstring(nextarg());
  300.   else
  301.     name = "";            /* default name */
  302.  
  303.   /* get optional <class_name> arg */
  304.   if (moreargs() && (stringp(*xlargv)))
  305.     class_name = (char*) getstring(nextarg());
  306.   else
  307.     class_name = app_class;    /* default name */
  308.  
  309.   if (!(widgetclass_id = Wcls_WIDGETCLASSOBJ_To_WidgetClassID(getclass(self))))
  310.     xlerror("Expected a 'Class' object that is a subclass of 'WIDGET_CLASS'.", self);
  311.  
  312.   /*
  313.    * We handle wm deletion (f.kill) w/ XmAddWMProtocolCallback() below, therefore
  314.    * override the default delete-response of destroy...
  315.    */
  316.   ARGLIST_RESET(); ARGLIST_ADD(XmNdeleteResponse, XmDO_NOTHING);
  317.  
  318.   if (moreargs()) {        /* if there are more arguments, */
  319.     Cardinal xt_numargs;    /* then we have some extra widget resources to set */
  320.     ArgList xt_arglist = Wres_Get_LispArglist(self, toplevel_Wgt, ARGLIST(), &xt_numargs);
  321.  
  322.     /* NOTE POTENTIAL BUG: above, we pass toplevel_Wgt as the widget for
  323.        Wres_Get_LispArglist(). toplevel_Wgt is created by XtInitialize() in
  324.        winterp.c:main(). Wres_Get_LispArglist() may need to use that widget
  325.        for particular kinds of argument conversions done through XtConvert().
  326.        These resource converters reference things like the display/screen/
  327.        foreground/background. For those cases, do not attempt to invoke
  328.        XtConvert() by passing string-valued arguments to this method. Instead,
  329.        create the shell widget, and then use :set_values to set the arguments
  330.        requiring such conversions. This will really break bigtime if I ever
  331.        implement multiple AppContexts for multiscreen usage of WINTERP.
  332.        
  333.        Note also that below, we pass the global "display" -- this will have
  334.        to change for multi-display use....*/
  335.  
  336.     widget_id = XtAppCreateShell(name, class_name, widgetclass_id, display, xt_arglist, xt_numargs);
  337.     Wres_Free_C_Arglist_Data();
  338.   }
  339.   else
  340.     widget_id = XtAppCreateShell(name, class_name, widgetclass_id, display, ARGLIST());
  341.  
  342.   XmAddWMProtocolCallback(widget_id, wm_delete_atom, Winterp_Application_Shell_WMDelete_Callback, NULL);
  343.  
  344.   Wcls_Initialize_WIDGETOBJ(self, widget_id);
  345.   Wshl_Assoc_WidgetID_With_WIDGETOBJ(widget_id, self);
  346.   
  347. #ifdef DEBUG_WINTERP_1
  348.   Wcls_Print_WidgetObj_Info(self);
  349. #endif
  350.   return (self);
  351. }
  352.  
  353.  
  354. /*****************************************************************************
  355.  * (send <Popup_Shell_Widget_Class> :new
  356.  *                                       [<name>]
  357.  *                                       <parent> 
  358.  *                                       [:XMN_<arg1> <val1>]
  359.  *                                       [. . .             ]
  360.  *                                       [:XMN_<argN> <valN>])
  361.  *
  362.  * For the <Popup_Shell_Widget_Class> meta-class,
  363.  * create a new widget via XtCreatePopupShell().
  364.  ****************************************************************************/
  365. LVAL Popup_Shell_Widget_Class_Method_ISNEW()
  366. {
  367.   extern ArgList Wres_Get_LispArglist(); /* from w_resources.c */
  368.   extern void    Wres_Free_C_Arglist_Data(); /* from w_resources.c */
  369.   extern WidgetClass Wcls_WIDGETCLASSOBJ_To_WidgetClassID(); /* w_classes.c */
  370.   LVAL self;
  371.   LVAL o_parent;
  372.   char* name;
  373.   WidgetClass widgetclass_id;
  374.   Widget parent_widget_id, widget_id;
  375.  
  376.   self = xlgaobject();        /* NOTE: xlobj.c:clnew() returns an OBJECT; if this method
  377.                    returns successfully, it will return a WIDGETOBJ */
  378.  
  379.   /* get optional <name> arg */
  380.   if (moreargs() && (stringp(*xlargv)))
  381.     name = (char*) getstring(nextarg());
  382.   else
  383.     name = "";            /* default name */
  384.  
  385.   /* get required <parent> widget-object arg */
  386.   parent_widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&o_parent);
  387.  
  388.   if (!(widgetclass_id = Wcls_WIDGETCLASSOBJ_To_WidgetClassID(getclass(self))))
  389.     xlerror("Expected a 'Class' object that is a subclass of 'WIDGET_CLASS'.", self);
  390.  
  391.   if (moreargs()) {        /* if there are more arguments, */
  392.     Cardinal xt_numargs;    /* then we have some extra widget resources to set */
  393.     ArgList xt_arglist = Wres_Get_LispArglist(self, parent_widget_id, NULL, 0, &xt_numargs);
  394.     widget_id = XtCreatePopupShell(name, widgetclass_id, parent_widget_id, xt_arglist, xt_numargs);
  395.     Wres_Free_C_Arglist_Data();
  396.   }
  397.   else
  398.     widget_id = XtCreatePopupShell(name, widgetclass_id, parent_widget_id, NULL, 0);
  399.  
  400.   Wcls_Initialize_WIDGETOBJ(self, widget_id);
  401.   Wshl_Assoc_WidgetID_With_WIDGETOBJ(widget_id, self);
  402.  
  403. #ifdef DEBUG_WINTERP_1
  404.   Wcls_Print_WidgetObj_Info(self);
  405. #endif
  406.   return (self);
  407. }
  408.  
  409.  
  410. /*****************************************************************************
  411.  * (send <Popup_Shell_Widget_Instance> :popup <grabkind>)
  412.  * where <grabkind> is one of the following keyword symbols: 
  413.  *                  :grab_none, :grab_nonexclusive, or  :grab_exclusive.
  414.  ****************************************************************************/
  415. static LVAL k_grab_none;    /* initialized in Wc_SHELL_Init() */
  416. static LVAL k_grab_nonexclusive; /* initialized in Wc_SHELL_Init() */
  417. static LVAL k_grab_exclusive;    /* initialized in Wc_SHELL_Init() */
  418. LVAL Popup_Shell_Widget_Class_Method_POPUP()
  419. {
  420.   LVAL self, grabkind;
  421.   Widget widget_id;
  422.  
  423.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  424.   grabkind = xlgasymbol();
  425.   xllastarg();
  426.  
  427.   if (grabkind == k_grab_none)
  428.     XtPopup(widget_id, XtGrabNone);
  429.   else if (grabkind == k_grab_nonexclusive)
  430.     XtPopup(widget_id, XtGrabNonexclusive);
  431.   else if (grabkind == k_grab_exclusive)
  432.     XtPopup(widget_id, XtGrabExclusive);
  433.   else
  434.     xlerror("Unknown <grabkind> symbol. (Expected :grab_none, :grab_nonexclusive, or  :grab_exclusive)", grabkind);
  435.  
  436.   return (self);
  437. }
  438.  
  439.  
  440. /*****************************************************************************
  441.  * (send <Popup_Shell_Widget_Instance> :popdown)
  442.  ****************************************************************************/
  443. LVAL Popup_Shell_Widget_Class_Method_POPDOWN()
  444. {
  445.   LVAL self;
  446.   Widget widget_id;
  447.  
  448.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  449.   xllastarg();
  450.   
  451.   XtPopdown(widget_id);
  452.   return (self);
  453. }
  454.  
  455.  
  456. /*****************************************************************************
  457.  * (send <Shell_Widget_Instance> :realize)
  458.  ****************************************************************************/
  459. LVAL Shell_Widget_Class_Method_REALIZE()
  460. {
  461.   LVAL self;
  462.   Widget widget_id;
  463.  
  464.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  465.   xllastarg();
  466.  
  467.   XtRealizeWidget(widget_id);
  468.   return (self);
  469. }
  470.  
  471.  
  472. /*****************************************************************************
  473.  * (send <Shell_Widget_Instance> :unrealize)
  474.  ****************************************************************************/
  475. LVAL Shell_Widget_Class_Method_UNREALIZE()
  476. {
  477.   LVAL self;
  478.   Widget widget_id;
  479.  
  480.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  481.   xllastarg();
  482.  
  483.   XtUnrealizeWidget(widget_id);
  484.   return (self);
  485. }
  486.  
  487.  
  488. /******************************************************************************
  489.  * (send <Shell_Widget_Instance> :IS_MOTIF_WM_RUNNING)
  490.  * returns T if mwm is running, else NIL.
  491.  *
  492.  * extern Boolean XmIsMotifWMRunning(shell);
  493.  *        Widget shell;
  494.  *******************************************************************************/
  495. LVAL Shell_Widget_Class_Method_IS_MOTIF_WM_RUNNING()
  496. {
  497.   extern LVAL true;
  498.   LVAL self;
  499.   Widget widget_id;
  500.  
  501.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  502.   xllastarg();
  503.  
  504.   return (XmIsMotifWMRunning(widget_id) ? true : NIL);
  505. }
  506.  
  507. /******************************************************************************
  508.  * (send <Application_Shell_Widget_Instance> :GET_ARGV)
  509.  *     ==> returns an array of strings.
  510.  *
  511.  * This retrieves the resources XmNargv and XmNargc from <Application_Shell_Widget_Instance>
  512.  * and returns an array of strings representing the command line args with
  513.  * which the program was called.
  514.  *******************************************************************************/
  515. LVAL Application_Shell_Widget_Class_Method_GET_ARGV()
  516. {
  517.   LVAL self, result;
  518.   Widget widget_id;
  519.   String* retrieved_argv;
  520.   int     retrieved_argc, i;
  521.  
  522.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self); /* get <Application_Shell_Widget_Instance>  */
  523.   xllastarg();
  524.  
  525.   ARGLIST_RESET();
  526.   ARGLIST_ADD(XmNargc, &retrieved_argc);
  527.   ARGLIST_ADD(XmNargv, &retrieved_argv);
  528.   XtGetValues(widget_id, ARGLIST());
  529.  
  530.   if (retrieved_argc == 0)
  531.     return (NIL);
  532.   if (retrieved_argv == NULL)
  533.     return (NIL);
  534.   
  535.   xlsave1(result);
  536.  
  537.   result = newvector(retrieved_argc);
  538.  
  539.   for (i = 0; i < retrieved_argc; i++)
  540.     setelement(result, i, cvstring(retrieved_argv[i]));    /* cvstring() copies the string. This copy may be freed later via garbage collection. */
  541.  
  542.   xlpop();
  543.   return (result);
  544. }
  545.  
  546.  
  547. /******************************************************************************
  548.  * (send <Application_Shell_Widget_Instance> :SET_ARGV <args>)
  549.  * returns <Application_Shell_Widget_Instance>.
  550.  *
  551.  * This sets the XmNargv and XmNargc resources based on the sequence of string
  552.  * arguments <args>. The resources are set on <Application_Shell_Widget_Instance> 
  553.  * and this supposedly will allow session managers that the application should
  554.  * start up with the new <args> specified here.
  555.  *******************************************************************************/
  556. #define STRINGTABLE_SIZE_INCREMENT 20
  557. LVAL Application_Shell_Widget_Class_Method_SET_ARGV()
  558. {
  559.   LVAL self, lval_args, elt;
  560.   Widget widget_id;
  561.   String string_from_lisp, string_to_c;
  562.   int     string_length, i;
  563.   String* set_argv = NULL;
  564.   int     set_argc = 0;
  565.  
  566.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self); /* get <Application_Shell_Widget_Instance>  */
  567.   lval_args = xlgetarg();    /* get <args> */
  568.   xllastarg();
  569.  
  570.   /*
  571.    * if argument is a vector, then step through array of lisp <string>.
  572.    */
  573.   if (vectorp(lval_args)) {
  574.     set_argc = getsize(lval_args);
  575.     set_argv = (String*) XtMalloc((unsigned) ((set_argc + 1) * sizeof(String)));
  576.  
  577.     for (i = 0 ; i < set_argc ; i++) {
  578.       elt = getelement(lval_args, i);
  579.       if (stringp(elt)) {
  580.     if (string_from_lisp = (String) getstring(elt)) {
  581.       string_length = getslength(elt);
  582.       string_to_c = (String) XtMalloc((unsigned) (string_length + 1) * sizeof(char)); /* unpluggable memory leak -- XmNargv doesn't get copied in widget... */
  583.       string_to_c = strncpy(string_to_c, string_from_lisp, string_length);
  584.       string_to_c[string_length] = '\000';
  585.       set_argv[i] = string_to_c;
  586.     }
  587.     else
  588.       set_argv[i] = "";
  589.       }
  590.       else {
  591.     XtFree(set_argv);
  592.     xlerror("Expected as argument a sequence (list or vector) of strings; encountered a non-string array element.", elt);
  593.       }
  594.     }
  595.     set_argv[i] = NULL;        /* null terminate */
  596.     /* implicit: set_argc = i; */
  597.   }
  598.   /*
  599.    * if argument is a list, then cdr through list of lisp <string>
  600.    */
  601.   else if (consp(lval_args)) {
  602.     int size = STRINGTABLE_SIZE_INCREMENT;
  603.     set_argv = (String*) XtMalloc((unsigned) ((size + 1) * sizeof(String)));
  604.  
  605.     for (i = 0 ; (consp(lval_args)) ; lval_args = cdr(lval_args), i++) {
  606.       if (i >= size) {        /* make sure it'll fit into allocated set_argv */
  607.     size += STRINGTABLE_SIZE_INCREMENT;
  608.     set_argv = (String*) XtRealloc(set_argv, (unsigned) ((size + 1) * sizeof(String)));
  609.       }
  610.       elt = car(lval_args);
  611.       if (stringp(elt)) {
  612.     if (string_from_lisp = (String) getstring(elt)) {
  613.       string_length = strlen(string_from_lisp);
  614.       string_to_c = (String) XtMalloc((unsigned) (string_length + 1) * sizeof(char)); /* unpluggable memory leak -- XmNargv doesn't get copied in widget... */
  615.       string_to_c = strncpy(string_to_c, string_from_lisp, string_length);
  616.       string_to_c[string_length] = '\000';
  617.       set_argv[i] = string_to_c;
  618.     }
  619.     else
  620.       set_argv[i] = "";
  621.       }
  622.       else {
  623.     XtFree(set_argv);
  624.     xlerror("Expected as argument a sequence (list or vector) of strings; encountered a non-string list element.", elt);
  625.       }
  626.     }
  627.  
  628.     if (lval_args) {        /* if loop terminated due to list pointer not being a CONS cell */
  629.       XtFree(set_argv);
  630.       xlerror("Expected as argument a sequence (list or vector) of strings; encountered a weird list tail.", lval_args);
  631.     }
  632.  
  633.     set_argv[i] = NULL;        /* null terminate */
  634.     set_argc = i;
  635.   }
  636.   /*
  637.    * if argument wasn't list or vector, then error
  638.    */
  639.   else
  640.     xlerror("Wrong argument type given; Expected as argument a sequence (list or vector) of strings." , lval_args);
  641.  
  642.   ARGLIST_RESET();
  643.   ARGLIST_ADD(XmNargc, (XtArgVal) set_argc);
  644.   ARGLIST_ADD(XmNargv, (XtArgVal) set_argv);
  645.   XtSetValues(widget_id, ARGLIST());
  646.  
  647.   /*
  648.    * Normally, we'd want to free set_argv after passing it to the widget via XtSetValues().
  649.    * However, Motif/Xt has a bug in that if you free argv before XtRealize() gets called
  650.    * you'll get a core dump. Therefore, I don't free argv. On the other hand, this
  651.    * definitely causes a memory leak, but the fault lies in the Xtoolkit and Motif.
  652.    */
  653. #ifdef THE_FOLLOWING_CODE_IS_COMMENTED_OUT
  654.   if (set_argv)
  655.     XtFree(set_argv);
  656. #endif                /* THE_FOLLOWING_CODE_IS_COMMENTED_OUT */
  657.  
  658.  
  659.   return (self);
  660. }
  661.  
  662.  
  663.  
  664. /******************************************************************************
  665.  *
  666.  ******************************************************************************/
  667. Wc_SHELL_Init()
  668. {
  669.   LVAL o_TOP_LEVEL_SHELL_WIDGET_CLASS;
  670.   LVAL o_TOP_LEVEL_POPUP_SHELL_WIDGET_CLASS;
  671.   LVAL o_APPLICATION_SHELL_WIDGET_CLASS;
  672.   LVAL o_APPLICATION_POPUP_SHELL_WIDGET_CLASS;
  673.   LVAL o_OVERRIDE_SHELL_WIDGET_CLASS;
  674.   LVAL o_OVERRIDE_POPUP_SHELL_WIDGET_CLASS;
  675.   LVAL o_TRANSIENT_SHELL_WIDGET_CLASS;
  676.   LVAL o_TRANSIENT_POPUP_SHELL_WIDGET_CLASS;
  677.   LVAL o_XM_DIALOG_POPUP_SHELL_WIDGET_CLASS;
  678.   LVAL o_XM_MENU_POPUP_SHELL_WIDGET_CLASS;
  679.   extern LVAL Wcls_Create_Subclass_Of_WIDGET_CLASS(); /* w_classes.c */
  680.   extern      xladdmsg();    /* from xlobj.c */
  681.  
  682.   k_grab_none          = xlenter(":GRAB_NONE");
  683.   k_grab_nonexclusive  = xlenter(":GRAB_NONEXCLUSIVE");
  684.   k_grab_exclusive     = xlenter(":GRAB_EXCLUSIVE");
  685.  
  686.   /*------------------- TOP_LEVEL_SHELL_WIDGET_CLASS -----------------------*/
  687.   o_TOP_LEVEL_SHELL_WIDGET_CLASS = 
  688.     Wcls_Create_Subclass_Of_WIDGET_CLASS("TOP_LEVEL_SHELL_WIDGET_CLASS",
  689.                      topLevelShellWidgetClass);
  690.   xladdmsg(o_TOP_LEVEL_SHELL_WIDGET_CLASS, ":IS_MOTIF_WM_RUNNING", 
  691.        FTAB_Shell_Widget_Class_Method_IS_MOTIF_WM_RUNNING);
  692.   xladdmsg(o_TOP_LEVEL_SHELL_WIDGET_CLASS, ":UNREALIZE", 
  693.        FTAB_Shell_Widget_Class_Method_UNREALIZE);
  694.   xladdmsg(o_TOP_LEVEL_SHELL_WIDGET_CLASS, ":ISNEW", 
  695.        FTAB_Shell_Widget_Class_Method_ISNEW);
  696.   xladdmsg(o_TOP_LEVEL_SHELL_WIDGET_CLASS, ":REALIZE", 
  697.        FTAB_Shell_Widget_Class_Method_REALIZE);
  698.  
  699.   /*------------------- TOP_LEVEL_POPUP_SHELL_WIDGET_CLASS ------------------*/
  700.   o_TOP_LEVEL_POPUP_SHELL_WIDGET_CLASS = 
  701.     Wcls_Create_Subclass_Of_WIDGET_CLASS("TOP_LEVEL_POPUP_SHELL_WIDGET_CLASS",
  702.                      topLevelShellWidgetClass);
  703.  
  704.   xladdmsg(o_TOP_LEVEL_POPUP_SHELL_WIDGET_CLASS, ":IS_MOTIF_WM_RUNNING", 
  705.        FTAB_Shell_Widget_Class_Method_IS_MOTIF_WM_RUNNING);
  706.   xladdmsg(o_TOP_LEVEL_POPUP_SHELL_WIDGET_CLASS, ":UNREALIZE", 
  707.        FTAB_Shell_Widget_Class_Method_UNREALIZE);
  708.   xladdmsg(o_TOP_LEVEL_POPUP_SHELL_WIDGET_CLASS, ":POPUP",
  709.        FTAB_Popup_Shell_Widget_Class_Method_POPUP);
  710.   xladdmsg(o_TOP_LEVEL_POPUP_SHELL_WIDGET_CLASS, ":POPDOWN",
  711.        FTAB_Popup_Shell_Widget_Class_Method_POPDOWN);
  712.   xladdmsg(o_TOP_LEVEL_POPUP_SHELL_WIDGET_CLASS, ":ISNEW", 
  713.        FTAB_Popup_Shell_Widget_Class_Method_ISNEW);
  714.   xladdmsg(o_TOP_LEVEL_POPUP_SHELL_WIDGET_CLASS, ":REALIZE", 
  715.        FTAB_Shell_Widget_Class_Method_REALIZE);
  716.  
  717.   /*------------------- APPLICATION_SHELL_WIDGET_CLASS -----------------------*/
  718.   o_APPLICATION_SHELL_WIDGET_CLASS = 
  719.     Wcls_Create_Subclass_Of_WIDGET_CLASS("APPLICATION_SHELL_WIDGET_CLASS",
  720.                      applicationShellWidgetClass);
  721.   xladdmsg(o_APPLICATION_SHELL_WIDGET_CLASS, ":GET_ARGV", 
  722.        FTAB_Application_Shell_Widget_Class_Method_GET_ARGV);
  723.   xladdmsg(o_APPLICATION_SHELL_WIDGET_CLASS, ":SET_ARGV", 
  724.        FTAB_Application_Shell_Widget_Class_Method_SET_ARGV);
  725.   xladdmsg(o_APPLICATION_SHELL_WIDGET_CLASS, ":IS_MOTIF_WM_RUNNING", 
  726.        FTAB_Shell_Widget_Class_Method_IS_MOTIF_WM_RUNNING);
  727.   xladdmsg(o_APPLICATION_SHELL_WIDGET_CLASS, ":UNREALIZE", 
  728.        FTAB_Shell_Widget_Class_Method_UNREALIZE);
  729.   /*
  730.    * note special initializer method which sets up f.kill handler
  731.    * so that WINTERP exits cleanly.
  732.    */
  733.   xladdmsg(o_APPLICATION_SHELL_WIDGET_CLASS, ":ISNEW", 
  734.        FTAB_Application_Shell_Widget_Class_Method_ISNEW); 
  735.   xladdmsg(o_APPLICATION_SHELL_WIDGET_CLASS, ":REALIZE", 
  736.        FTAB_Shell_Widget_Class_Method_REALIZE);
  737.  
  738.   /*------------------- APPLICATION_POPUP_SHELL_WIDGET_CLASS -----------------------*/
  739.   o_APPLICATION_POPUP_SHELL_WIDGET_CLASS = 
  740.     Wcls_Create_Subclass_Of_WIDGET_CLASS("APPLICATION_POPUP_SHELL_WIDGET_CLASS",
  741.                      applicationShellWidgetClass);
  742.   xladdmsg(o_APPLICATION_POPUP_SHELL_WIDGET_CLASS, ":GET_ARGV", 
  743.        FTAB_Application_Shell_Widget_Class_Method_GET_ARGV);
  744.   xladdmsg(o_APPLICATION_POPUP_SHELL_WIDGET_CLASS, ":SET_ARGV", 
  745.        FTAB_Application_Shell_Widget_Class_Method_SET_ARGV);
  746.   xladdmsg(o_APPLICATION_POPUP_SHELL_WIDGET_CLASS, ":IS_MOTIF_WM_RUNNING", 
  747.        FTAB_Shell_Widget_Class_Method_IS_MOTIF_WM_RUNNING);
  748.   xladdmsg(o_APPLICATION_POPUP_SHELL_WIDGET_CLASS, ":UNREALIZE", 
  749.        FTAB_Shell_Widget_Class_Method_UNREALIZE);
  750.   xladdmsg(o_APPLICATION_POPUP_SHELL_WIDGET_CLASS, ":POPUP",
  751.        FTAB_Popup_Shell_Widget_Class_Method_POPUP);
  752.   xladdmsg(o_APPLICATION_POPUP_SHELL_WIDGET_CLASS, ":POPDOWN",
  753.        FTAB_Popup_Shell_Widget_Class_Method_POPDOWN);
  754.   xladdmsg(o_APPLICATION_POPUP_SHELL_WIDGET_CLASS, ":ISNEW", 
  755.        FTAB_Popup_Shell_Widget_Class_Method_ISNEW);
  756.   xladdmsg(o_APPLICATION_POPUP_SHELL_WIDGET_CLASS, ":REALIZE", 
  757.        FTAB_Shell_Widget_Class_Method_REALIZE);
  758.  
  759.   /*------------------- OVERRIDE_SHELL_WIDGET_CLASS -----------------------*/
  760.   o_OVERRIDE_SHELL_WIDGET_CLASS = 
  761.     Wcls_Create_Subclass_Of_WIDGET_CLASS("OVERRIDE_SHELL_WIDGET_CLASS",
  762.                      overrideShellWidgetClass);
  763.   xladdmsg(o_OVERRIDE_SHELL_WIDGET_CLASS, ":IS_MOTIF_WM_RUNNING", 
  764.        FTAB_Shell_Widget_Class_Method_IS_MOTIF_WM_RUNNING);
  765.   xladdmsg(o_OVERRIDE_SHELL_WIDGET_CLASS, ":UNREALIZE", 
  766.        FTAB_Shell_Widget_Class_Method_UNREALIZE);
  767.   xladdmsg(o_OVERRIDE_SHELL_WIDGET_CLASS, ":ISNEW", 
  768.        FTAB_Shell_Widget_Class_Method_ISNEW);
  769.   xladdmsg(o_OVERRIDE_SHELL_WIDGET_CLASS, ":REALIZE", 
  770.        FTAB_Shell_Widget_Class_Method_REALIZE);
  771.  
  772.   /*------------------- OVERRIDE_POPUP_SHELL_WIDGET_CLASS -----------------------*/
  773.   o_OVERRIDE_POPUP_SHELL_WIDGET_CLASS = 
  774.     Wcls_Create_Subclass_Of_WIDGET_CLASS("OVERRIDE_POPUP_SHELL_WIDGET_CLASS",
  775.                      overrideShellWidgetClass);
  776.   xladdmsg(o_OVERRIDE_POPUP_SHELL_WIDGET_CLASS, ":IS_MOTIF_WM_RUNNING", 
  777.        FTAB_Shell_Widget_Class_Method_IS_MOTIF_WM_RUNNING);
  778.   xladdmsg(o_OVERRIDE_POPUP_SHELL_WIDGET_CLASS, ":UNREALIZE", 
  779.        FTAB_Shell_Widget_Class_Method_UNREALIZE);
  780.   xladdmsg(o_OVERRIDE_POPUP_SHELL_WIDGET_CLASS, ":POPUP",
  781.        FTAB_Popup_Shell_Widget_Class_Method_POPUP);
  782.   xladdmsg(o_OVERRIDE_POPUP_SHELL_WIDGET_CLASS, ":POPDOWN",
  783.        FTAB_Popup_Shell_Widget_Class_Method_POPDOWN);
  784.   xladdmsg(o_OVERRIDE_POPUP_SHELL_WIDGET_CLASS, ":ISNEW", 
  785.        FTAB_Popup_Shell_Widget_Class_Method_ISNEW);
  786.   xladdmsg(o_OVERRIDE_POPUP_SHELL_WIDGET_CLASS, ":REALIZE", 
  787.        FTAB_Shell_Widget_Class_Method_REALIZE);
  788.  
  789.   /*------------------- TRANSIENT_SHELL_WIDGET_CLASS -----------------------*/
  790.   o_TRANSIENT_SHELL_WIDGET_CLASS = 
  791.     Wcls_Create_Subclass_Of_WIDGET_CLASS("TRANSIENT_SHELL_WIDGET_CLASS",
  792.                      transientShellWidgetClass);
  793.   xladdmsg(o_TRANSIENT_SHELL_WIDGET_CLASS, ":IS_MOTIF_WM_RUNNING", 
  794.        FTAB_Shell_Widget_Class_Method_IS_MOTIF_WM_RUNNING);
  795.   xladdmsg(o_TRANSIENT_SHELL_WIDGET_CLASS, ":UNREALIZE", 
  796.        FTAB_Shell_Widget_Class_Method_UNREALIZE);
  797.   xladdmsg(o_TRANSIENT_SHELL_WIDGET_CLASS, ":ISNEW", 
  798.        FTAB_Shell_Widget_Class_Method_ISNEW);
  799.   xladdmsg(o_TRANSIENT_SHELL_WIDGET_CLASS, ":REALIZE", 
  800.        FTAB_Shell_Widget_Class_Method_REALIZE);
  801.  
  802.   /*------------------- TRANSIENT_POPUP_SHELL_WIDGET_CLASS -----------------------*/
  803.   o_TRANSIENT_POPUP_SHELL_WIDGET_CLASS = 
  804.     Wcls_Create_Subclass_Of_WIDGET_CLASS("TRANSIENT_POPUP_SHELL_WIDGET_CLASS",
  805.                      transientShellWidgetClass);
  806.   xladdmsg(o_TRANSIENT_POPUP_SHELL_WIDGET_CLASS, ":IS_MOTIF_WM_RUNNING", 
  807.        FTAB_Shell_Widget_Class_Method_IS_MOTIF_WM_RUNNING);
  808.   xladdmsg(o_TRANSIENT_POPUP_SHELL_WIDGET_CLASS, ":UNREALIZE", 
  809.        FTAB_Shell_Widget_Class_Method_UNREALIZE);
  810.   xladdmsg(o_TRANSIENT_POPUP_SHELL_WIDGET_CLASS, ":POPUP",
  811.        FTAB_Popup_Shell_Widget_Class_Method_POPUP);
  812.   xladdmsg(o_TRANSIENT_POPUP_SHELL_WIDGET_CLASS, ":POPDOWN",
  813.        FTAB_Popup_Shell_Widget_Class_Method_POPDOWN);
  814.   xladdmsg(o_TRANSIENT_POPUP_SHELL_WIDGET_CLASS, ":ISNEW", 
  815.        FTAB_Popup_Shell_Widget_Class_Method_ISNEW);
  816.   xladdmsg(o_TRANSIENT_POPUP_SHELL_WIDGET_CLASS, ":REALIZE", 
  817.        FTAB_Shell_Widget_Class_Method_REALIZE);
  818.  
  819.   /*-------------------- XM_DIALOG_POPUP_SHELL_WIDGET_CLASS ------------------------*/
  820.   o_XM_DIALOG_POPUP_SHELL_WIDGET_CLASS =
  821.     Wcls_Create_Subclass_Of_WIDGET_CLASS("XM_DIALOG_POPUP_SHELL_WIDGET_CLASS",
  822.                      xmDialogShellWidgetClass);
  823.   xladdmsg(o_XM_DIALOG_POPUP_SHELL_WIDGET_CLASS, ":IS_MOTIF_WM_RUNNING", 
  824.        FTAB_Shell_Widget_Class_Method_IS_MOTIF_WM_RUNNING);
  825.   xladdmsg(o_XM_DIALOG_POPUP_SHELL_WIDGET_CLASS, ":UNREALIZE", 
  826.        FTAB_Shell_Widget_Class_Method_UNREALIZE);
  827.   xladdmsg(o_XM_DIALOG_POPUP_SHELL_WIDGET_CLASS, ":POPUP",
  828.        FTAB_Popup_Shell_Widget_Class_Method_POPUP);
  829.   xladdmsg(o_XM_DIALOG_POPUP_SHELL_WIDGET_CLASS, ":POPDOWN",
  830.        FTAB_Popup_Shell_Widget_Class_Method_POPDOWN);
  831.   xladdmsg(o_XM_DIALOG_POPUP_SHELL_WIDGET_CLASS, ":ISNEW", 
  832.        FTAB_Popup_Shell_Widget_Class_Method_ISNEW);
  833.   xladdmsg(o_XM_DIALOG_POPUP_SHELL_WIDGET_CLASS, ":REALIZE", 
  834.        FTAB_Shell_Widget_Class_Method_REALIZE);
  835.  
  836.   /*-------------------- XM_MENU_POPUP_SHELL_WIDGET_CLASS ------------------------*/
  837.   o_XM_MENU_POPUP_SHELL_WIDGET_CLASS =
  838.     Wcls_Create_Subclass_Of_WIDGET_CLASS("XM_MENU_POPUP_SHELL_WIDGET_CLASS",
  839.                      xmMenuShellWidgetClass);
  840.   xladdmsg(o_XM_MENU_POPUP_SHELL_WIDGET_CLASS, ":IS_MOTIF_WM_RUNNING", 
  841.        FTAB_Shell_Widget_Class_Method_IS_MOTIF_WM_RUNNING);
  842.   xladdmsg(o_XM_MENU_POPUP_SHELL_WIDGET_CLASS, ":UNREALIZE", 
  843.        FTAB_Shell_Widget_Class_Method_UNREALIZE);
  844.   xladdmsg(o_XM_MENU_POPUP_SHELL_WIDGET_CLASS, ":POPUP",
  845.        FTAB_Popup_Shell_Widget_Class_Method_POPUP);
  846.   xladdmsg(o_XM_MENU_POPUP_SHELL_WIDGET_CLASS, ":POPDOWN",
  847.        FTAB_Popup_Shell_Widget_Class_Method_POPDOWN);
  848.   xladdmsg(o_XM_MENU_POPUP_SHELL_WIDGET_CLASS, ":ISNEW", 
  849.        FTAB_Popup_Shell_Widget_Class_Method_ISNEW);
  850.   xladdmsg(o_XM_MENU_POPUP_SHELL_WIDGET_CLASS, ":REALIZE", 
  851.        FTAB_Shell_Widget_Class_Method_REALIZE);
  852. }
  853.